home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
002
/
envptibm.arc
/
SIDEPRNT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1987-05-19
|
6KB
|
241 lines
{
SIDEPRNT ... sideways (rotated) printing ...
Author --- John T. Bagwell, Jr.
MODIFIED-- John R. DeBolt -- April 1987 to operate on an IBM
compatible, OKIDATA ML192 printer.
Uses Character tables in the BIOS ROM sto do a simple form of
sideways printing. Character values above 127 aren't supported.
Formfeed acts as a 'page' eject, even in the middle of a line;
a line ends at CR/LF, FF, or end-of-file.
}
program SidePrint;
const
PrintMultipleSpacing = #13#27#51#1#10;
JiggleDown = #13#27#51#24;
NormalSpacing = #27#65#12#27#50;
GraphicsPrint = #27;
ResetPrinter = #24;
LineFeed = #10;
FormFeed = #12;
AddX = 25;
{ possible choices }
BitsPerChar = 9; { 9 9 }
PrintType = #75; { #75 #75 }
N1 = #225; {#221 #225 }
N2 = #0; { #1 #0 }
MaxLineLen = 1000; { 480 480 }
MaxLinesPerPage = 25; { 53 25 }
type
BitMap = array[0..7] of Char;
Line = array[1..MaxLineLen] of Char;
var
zero1: byte;
Paper: array[1..MaxLinesPerPage] of Line;
zero2: byte;
LineNo,CharNo,i,j,k,BitsPerPage,LineLen: Integer;
Cindex,PrintMultiple: Byte;
RetFile,InFile: Text;
InChar: Char;
CharTable: array[0..127] of BitMap absolute $F000:$FA6E; {BIOS Table}
procedure ZERO;
begin
FillChar(zero1, ofs(zero2) - ofs(zero1) + sizeof(zero2), 0);
end;
(*---------------------------------*)
(* READ ONE PAGE *)
(*---------------------------------*)
procedure ReadOnePage;
var
LineSize: array[1..91] of Integer; {big enough for all options}
eject: Boolean;
begin
LineNo:=1;
CharNo:=0;
LineLen:=0;
eject:=False;
Zero;
For i:=1 to MaxLinesPerPage do {erase old lines}
LineSize[i]:=0;
repeat
{accumulate a line ...}
While (not eoln(RetFile)) AND (not eject) do
begin
Read(RetFile,InChar);
If InChar = FormFeed then {watch for page ejects}
If (LineNo = 1) AND (CharNo = 0) then
{Ignore redundant page ejects}
else
eject:=True
else
If CharNo <= MaxLineLen then {build a line}
begin
CharNo:=CharNo+1;
Paper[LineNo,CharNo]:=InChar;
end;
end;
{at end of each line ...}
If CharNo > LineLen then {save longest line length}
LineLen:=CharNo;
LineSize[LineNo]:=CharNo;
LineNo:=LineNo+1;
CharNo:=0;
If eoln(RetFile) then
ReadLn(RetFile); {get the end-of-line mark}
{force eject when page is full ...}
If LineNo > MaxLinesPerPage then
eject:=True;
until eof(RetFile) OR (eject);
LineNo:=12;
CharNo:=0;
LineLen:=0;
eject:=False;
repeat
{accumulate a line ...}
While (not eoln(InFile)) AND (not eject) do
begin
Read(InFile,InChar);
If InChar = FormFeed then {watch for page ejects}
If (LineNo = 1) AND (CharNo = 0) then
{Ignore redundant page ejects}
else
eject:=True
else
If CharNo <= MaxLineLen then {build a line}
begin
CharNo:=CharNo+1;
Paper[LineNo,CharNo+AddX]:=InChar;
end;
end;
{at end of each line ...}
If CharNo+AddX > LineLen then {save longest line length}
LineLen:=CharNo+AddX;
LineSize[LineNo]:=CharNo+AddX;
LineNo:=LineNo+1;
CharNo:=0;
If eoln(InFile) then
ReadLn(InFile); {get the end-of-line mark}
{force eject when page is full ...}
If LineNo > MaxLinesPerPage then
eject:=True;
until eof(InFile) OR (eject);
(* make each line the same length *)
For i:=1 to MaxLinesPerPage do
For j:=LineSize[i]+1 to LineLen do
Paper[i,j]:=' ';
end; {procedure ReadOnePage}
(*--------------------------------*)
(* PRINT ONE PAGE *)
(*--------------------------------*)
procedure PrintOnePage;
begin
For j:=1 to LineLen do {each rotated 'line'... actually, each character}
begin
For LineNo:=1 to PrintMultiple do
begin
If LineNo = 2 then Write(Lst,PrintMultipleSpacing);
Write(Lst,GraphicsPrint,PrintType,N1,N2);
For i:=MaxLinesPerPage downto 1 do {lines in reverse order}
begin
Cindex:=Ord(Paper[i,j]);
If BitsPerChar = 9 then {For loop (9 to ...) req'd if it is >9}
Write(Lst,#0);
For k:=7 downto 0 do
Write(Lst,CharTable[Cindex][k]); {bottom up each char}
end;
end;
Write(Lst,JiggleDown);
Write(Lst,LineFeed);
end;
end; {procedure PrintOnePage}
(* -------- MAIN PROGRAM -------- *)
begin
(* GET FILE PARAMETERS *)
If Paramcount < 1 then
begin
WriteLn(^G'Missing file name on command line');
Halt;
end;
Assign(RetFile,'C:RETURN.DAT');
{$I-}
Reset(RetFile);
{$I+}
If IOResult <> 0 then
begin
Writeln('File "RETURN.DAT" not found.');
Halt;
end;
Assign(InFile,Paramstr(1)); {OPEN the file}
{$I-}
Reset(InFile);
{$I+}
If IOResult <> 0 then
begin
WriteLn('File "',Paramstr(1),'" not found.');
Halt;
end;
(* GET /D DOUBLE-PRINT OPTION *)
PrintMultiple:=1;
If Paramcount >= 2 then
If (Paramstr(2) = '/d') OR (paramstr(2) = '/D') then
PrintMultiple:=2;
(* SET UP *)
BitsPerPage:=BitsPerChar * MaxLinesPerPage;
Write(Lst,ResetPrinter);
(* MAIN LOOP *)
Repeat {do one "page" at a time}
ReadOnePage;
PrintOnePage;
Write(Lst,FormFeed); {do a page eject to line up properly}
until eof(InFile);
(* ALL DONE *)
Close(InFile);
Write(Lst,ResetPrinter);
Write(Lst,NormalSpacing); {resume normal spacing vertically}
end. {main program}